Dictionaries & Language/Dictionaries and Language (Chestnut CD-ROM) (1993).iso/german/germanl/trans.pas

Pascal/Delphi Source File | 1988-03-31 | 28.0 KB | 1,002 lines

{$R-}    {Range checking off}
{$B+}    {Boolean complete evaluation on}
{$S+}    {Stack checking on}
{$I+}    {I/O checking on}
{$N-}    {No numeric coprocessor}
{$M 65500,16384,655360} {Turbo 3 default stack and heap}

PROGRAM TRANSLATE;



Uses
  Crt;

CONST
     STRINGSIZE = 80 ;
     COMMANDSIZE = 80;
     MAXSIZE = 80;
     SPACE = ' ';
     SENTINEL = '';
     VOCABLENGTH = 25;

 TYPE
     STRING_80 = string[STRINGSIZE];
     Placetype = ARRAY [0..12] of STRING_80 ;
     Vocabtype = ARRAY [1..350] of STRING_80 ;
     Deftype = ARRAY [1..350] of STRING_80 ;
     Choices = set of 1..10;
     STACKTYPE = ^STACKNODE;
     STACKNODE = record
     LEVEL:  INTEGER;
     WORD:  STRING_80;
{! 1.^ The SYSTEM unit now uses this name as a standard identifier.}
     SAME, SUB, NEXT  : STACKTYPE
   end;

 VAR
     INPUT    : STRING_80;
     ANSWER1   : STRING_80;
     QUESTNUM : STRING_80;
     QUESTCNT : INTEGER;
     Nums  : Choices;
     SpacePos  : INTEGER;
     WordCnt : INTEGER;
     Rnd : INTEGER;
     NonRepeatArray : Array[1..Vocablength] of INTEGER;
     TRANSLATFile :  Text{[$800]};
{! 2. Use the new standar^d procedure SetTextBuf to set Text buffer size.}
     COUNT     :  integer;
     Counter   :  integer;
     Counter1  :  integer;
     Counter2  :  integer;
     KOUNTER,KOUNTER1,KOUNTER2,KOUNTER3   :  INTEGER;
     CORRECTARRAY : ARRAY[1..100] of string_80;
     VOCABULARY : ARRAY[1..25] of string_80;
     Prepart   :  STRING_80;
     Object    :  STRING_80;
     Object1   :  STRING_80;
     Verb      :  STRING_80;
     Line      :  STRING_80;
     Instring  :  STRING_80;
     COMM : STRING_80;
     ROOT :  STACKTYPE;
     STUFF   : STACKNODE;
     INFILE  : TEXT;
     OUTFILE : TEXT;
     INT1    : INTEGER;
     INSTR1  : STRING_80;
     INST    : STRING_80;
     X       : BOOLEAN;
     CONT    : STRING_80;
     CH      : CHAR;
     INDEX   : INTEGER;
     FLAG1,FLAG2,FLAG3,FLAG4 : BOOLEAN;
     FIRST, SECOND, THIRD, FOURTH:  BOOLEAN;
     FLAGEXIT, FLAGADD : BOOLEAN;
     SAVESTR1, SAVESTR2, SAVESTR3, SAVESTR4, SAVESTR5 : STRING_80;
     FIRST_ELEMENT, SECOND_ELEMENT,THIRD_ELEMENT,FOURTH_ELEMENT, FIFTH_ELEMENT  : STRING_80;
     UTILNUM, NUM1, NUM2, NUM3, NUM4, NUM5 : INTEGER;
     HOR : INTEGER;
     LETTER : CHAR;
     Y  : INTEGER;
     doloop  : boolean ;
     doloop1 : boolean ;
     encompassingLoop : boolean;
     command : STRING_80 ;
     skeleton : STRING_80;
     word     : STRING_80;
     word1    : STRING_80;
     Lesson_Number : STRING_80;
     WordCnt1 : INTEGER;
     temp     :  INTEGER;
     Answer   :  STRING[20];
     Result   :  INTEGER;
 (****************************************************************************)
{Procedure Parse(var comm : string_80);

const
  Space     = ' ';

var
  Indx,Len  :  Integer;

begin
   Len:=0;
   while Pos(Space,comm)=1 do
      Delete(comm,1,1);
      Len:=Pos(Space,comm);
      Instring := Copy(comm,1,Len-1);
      Delete(comm,1,Len);
   end; }
   (*********************************************************************)
   procedure CreateWindow(X1,Y1,X2,Y2:  integer);


var
  border:  integer;

BEGIN

  window(1,1,80,25);
  GoToXY(X1,Y1) ; Write('┌'); GoToXY(X1,Y2); Write('└');
  For border  := (X1+1) to (X2-1) do
    begin
      GoToXY(border,Y1); Write('─');
      GoToXY(border,Y2); Write('─')
    end;
  GoToXY(X2,Y1); write('┐'); GoToXY(X2,Y2); Write('┘');
  for border :=(Y1+1) to (Y2-1) do
    begin
      GoToXY(X1,border); write('│');
      GoToXY(X2,border); write ('│')
    end;
  window(X1+1, Y1+1, X2-1, Y2-1);
  ClrScr;
  gotoXY(1,1);

END;



procedure MAKE(var STACK : STACKTYPE);

begin
  STACK := NIL
end;


  function GETREC(var WORKINT: INTEGER;var  WORKSTR:  STRING_80;
                var WORKFILE: TEXT): boolean;
   begin
        if not EOF(WORKFILE) then
            begin
              readln(WORKFILE, WORKINT);
              readln(WORKFILE, WORKSTR);
              GETREC := TRUE
            end
        else begin
               GETREC := FALSE
             end
   end;

function SCANTREE(var WRKINT : INTEGER ; WRKSTR : STRING_80;
                  var BEGINPTR : STACKTYPE;
                  var SUBPTR   : STACKTYPE): boolean;

var
  SCANPTR  :  STACKTYPE;
  TRAILPTR :  STACKTYPE;

begin
  if (BEGINPTR = NIL) then begin
       SCANTREE := FALSE
     end
   else begin
     TRAILPTR := BEGINPTR;
     SCANPTR  := BEGINPTR;
     if (WRKINT <> SCANPTR^.LEVEL) then begin
       SCANPTR := SCANPTR^.SUB;
     end;
     if (SCANPTR = NIL) then
       begin
         SCANTREE := FALSE;
         SUBPTR := TRAILPTR
       end
       else begin
         while ((SCANPTR <> NIL) and (SCANPTR^.WORD <> WRKSTR)) do
           begin
             TRAILPTR := SCANPTR;
             SCANPTR := SCANPTR^.SAME
           end;
           if (SCANPTR = NIL) then begin
             SCANTREE := FALSE;
             SUBPTR := TRAILPTR
           end
           else begin
             SCANTREE := TRUE;
             SUBPTR := SCANPTR
           end
       end
   end
end;





function ISBRANCH(var ININT1 : INTEGER ; var INSTR1 : STRING_80;
                  var ININT2 : INTEGER ; var INSTR2 : STRING_80;
                  var ININT3 : INTEGER ; var INSTR3 : STRING_80;
                  var ININT4 : INTEGER ; var INSTR4 : STRING_80;
                  var ININT5 : INTEGER ; var INSTR5 : STRING_80;
                  var ROOT   : STACKTYPE): boolean;

var
  SCANPTR1, ISPTR1, ISPTR2, ISPTR3, ISPTR4, ISPTR5 : STACKTYPE;
  INPUT : STRING_80;

begin
  ISBRANCH := FALSE;
  if not SCANTREE(ININT1, INSTR1, ROOT, ISPTR1) then begin
    CreateWindow(1,12,80,23);
    TextColor(15);
    writeln('False First Element.');
    WRITELN('Use one of the following elements: ');
    SCANPTR1:=ROOT;
    while SCANPTR1 <> nil do begin
      WRITE(SCANPTR1^.WORD+'  ');
      SCANPTR1 := SCANPTR1^.SAME;
    end;
    writeln;
    writeln('PRESS RETURN TO CONTINUE');
    readln(INPUT);
    ClrScr;
    CreateWindow(1,1,80,11);
    GotoXY(1,1);
    ClrScr
  end
  else begin
    if not SCANTREE(ININT2, INSTR2, ISPTR1, ISPTR2) then begin
    CreateWindow(1,12,80,23);
    TextColor(15);
      writeln('False Second Element.');
      writeln('With First Element "',First_element,'" use the following next element:');
      SCANPTR1:=ISPTR1^.SUB;
      while SCANPTR1<>nil do begin
        WRITE(SCANPTR1^.WORD+'  ');
        SCANPTR1 := SCANPTR1^.SAME
      end;
      writeln;
      writeln('PRESS RETURN TO CONTINUE');
      readln(INPUT);
      ClrScr;
      CreateWindow(1,1,80,11);
      GotoXY(1,1);
      ClrScr
    end
    else begin
      if not SCANTREE(ININT3, INSTR3, ISPTR2, ISPTR3) then begin
      CreateWindow(1,12,80,23);
      TextColor(15);
        writeln('False Third Element.');
        writeln('With First Element "',First_element,'" and Second Element "',Second_element,'"');
        writeln('Use the following element:');
        SCANPTR1:=ISPTR2^.SUB;
        while SCANPTR1<>nil do begin
          WRITE(SCANPTR1^.WORD+'  ');
          SCANPTR1 := SCANPTR1^.SAME
        end;
        writeln;
        writeln('PRESS RETURN TO CONTINUE');
        readln(INPUT);
        ClrScr;
        CreateWindow(1,1,80,11);
        GotoXY(1,1);
        ClrScr
      end
      else begin
        if not SCANTREE(ININT4, INSTR4, ISPTR3, ISPTR4) then begin
        CreateWindow(1,12,80,23);
        TextColor(15);
        if INSTR3='na' then
          begin

            writeln('With first element "',First_element,'" and second element "',Second_element,'"');
            writeln(' use the article:');
            SCANPTR1:=ISPTR3^.SUB;
             while SCANPTR1<>nil do begin
               WRITE(SCANPTR1^.WORD+'  ');
               WRITELN(INSTR1 + ' '+ INSTR2 +' '+SCANPTR1^.WORD);
               SCANPTR1 := SCANPTR1^.SAME
             end
           end
        else
          begin
            writeln('False Fourth Element.');
            writeln('With First element "',First_Element,'",Second Element "',Second_Element,'"');
            writeln('and Third Element "',Third_Element,'" use following Fourth Elements:');
            SCANPTR1:=ISPTR3^.SUB;
              while SCANPTR1<>nil do begin
              WRITELN(SCANPTR1^.WORD);
              WRITELN(INSTR1+' '+INSTR2 +' '+ INSTR3 +' '+SCANPTR1^.WORD);
              SCANPTR1 := SCANPTR1^.SAME
            end
          end;
        writeln('PRESS RETURN TO CONTINUE');
        readln(INPUT);
        ClrScr;
        CreateWindow(1,1,80,11);
        GotoXY(1,1);
        ClrScr
      end
      else begin
      if not SCANTREE(ININT5, INSTR5, ISPTR4, ISPTR5) then begin
      CreateWindow(1,12,80,23);
      TextColor(15);
        writeln('Correct sentence but incorrect translation.');
        writeln('Please try again.');
        writeln;
        writeln('PRESS RETURN TO CONTINUE');
        readln(INPUT);
        ClrScr;
        CreateWindow(1,1,80,11);
        GotoXY(1,1);
        ClrScr
      end
        else ISBRANCH := TRUE
        end
      end
    end
  end
end;

procedure ADDLEAVES(var BRANCH  : STACKTYPE; var PASSLEAF: STACKTYPE;
                     var PASSFILE : TEXT);

var
  TEMPLEAF   :  STACKTYPE;
  ININT      :  INTEGER;
  INSTR      :  STRING_80;
  FLAGEND    :  BOOLEAN;
  INFILE     :  TEXT;

begin
    if not GETREC(ININT, INSTR, PASSFILE) then PASSLEAF := NIL
    else
      begin
        NEW(TEMPLEAF);
        TEMPLEAF^.SAME:=NIL;
        TEMPLEAF^.SUB:=NIL;
        TEMPLEAF^.LEVEL  := ININT;
        TEMPLEAF^.WORD := INSTR;
        if TEMPLEAF^.LEVEL > BRANCH^.LEVEL then
          begin
            BRANCH^.SUB  := TEMPLEAF;
            ADDLEAVES(BRANCH^.SUB, PASSLEAF, PASSFILE);
            TEMPLEAF := PASSLEAF
          end;
        if ((TEMPLEAF <> NIL) AND (TEMPLEAF^.LEVEL = BRANCH^.LEVEL)) then
          begin
            BRANCH^.SAME := TEMPLEAF;
            ADDLEAVES(BRANCH^.SAME, PASSLEAF, PASSFILE);
            TEMPLEAF := PASSLEAF
          end;
        if ((TEMPLEAF <> NIL) AND (TEMPLEAF^.LEVEL < BRANCH^.LEVEL)) then
          begin
            PASSLEAF := TEMPLEAF
          end;
     end;
end;

procedure RECALLTREE (var LEAF  :  STACKTYPE);

  var
    TEMPREC, PASSREC : STACKTYPE;
    WORKINT  : INTEGER;
    WORKSTR  : STRING_80;
    INFILE   : TEXT;

begin
        ASSIGN(INFILE, Lesson_Number+'.tre');
        RESET(INFILE);
        X :=GETREC(WORKINT,WORKSTR,INFILE);
        NEW(TEMPREC);
        TEMPREC^.SAME:=NIL;
        TEMPREC^.SUB:=NIL;
        TEMPREC^.LEVEL := WORKINT;
        TEMPREC^.WORD := WORKSTR;
        LEAF  :=  TEMPREC;
        PASSREC := NIL;
        ADDLEAVES(LEAF, PASSREC, INFILE);
        CLOSE(INFILE)
end;

Procedure CreateOrder(Instring: String_80);


begin
  Count := Count +1;
  If Count = 1 then
    begin
      First_element := Instring;
      write(First_Element+'  ')
    end;
  If Count = 2 then
    begin
      Second_Element := Instring;
      If Second_Element = First_Element
        then
          begin
            Second_Element := '';
            Count := Count -1
          end;
      Write(Second_Element+'  ')
   end;
  If Count = 3 then
    begin
      Third_Element := Instring;
      If Third_Element = Second_Element
        then
          begin
            Third_Element := '';
            Count := Count -1
          end;
      Write(Third_Element+'  ')
    end;
  If Count = 4 then
    begin
      Fourth_element := Instring;
      If Fourth_Element = Third_Element
        then
          begin
            Fourth_Element := '';
            Count := Count -1
          end;
      Write(Fourth_Element+'  ')
    end
end;


function FINDBRANCH (var W, X, Y, Z, V : INTEGER;
                     var OUTSTRNG1, OUTSTRNG2, OUTSTRNG3, OUTSTRNG4, OUTSTRNG5, Instring: STRING_80;
                     var STEM : STACKTYPE): boolean;


var
  FINDPTR   : STACKTYPE;
  FLAG      : boolean;
  A,B,C,D,E : INTEGER;

begin
  FLAG := TRUE;
  A := W; B := X; C := Y; D := Z; E := V;
  OUTSTRNG1:='EMPTY';OUTSTRNG2:='EMPTY';
  OUTSTRNG3:='EMPTY';OUTSTRNG4:='EMPTY';OUTSTRNG5:='EMPTY';
  FINDPTR := STEM;
  while ((W <> 1) and (FINDPTR <> NIL)) do
    begin
      FINDPTR := FINDPTR^.SAME;
      W := W - 1
    end;
  W := A;
  if FINDPTR = NIL then FLAG := FALSE
  else
    begin
      OUTSTRNG1 := FINDPTR^.WORD;
      FINDPTR   := FINDPTR^.SUB;
      while ((X <> 1) and (FINDPTR <> NIL)) do
        begin
          FINDPTR := FINDPTR^.SAME;
          X := X - 1
        end;
        X := B;
        if FINDPTR = NIL then FLAG := FALSE
        else
          begin
            OUTSTRNG2 := FINDPTR^.WORD;
            FINDPTR   := FINDPTR^.SUB;
            while ((Y <> 1) and (FINDPTR <> NIL)) do
              begin
                FINDPTR := FINDPTR^.SAME;
                Y := Y - 1;
              end;
              Y := C;
              if FINDPTR = NIL then FLAG := FALSE
              else
                begin
                  OUTSTRNG3 := FINDPTR^.WORD;
                  FINDPTR   := FINDPTR^.SUB;
                  while ((Z <> 1) and (FINDPTR <> NIL)) do
                    begin
                      FINDPTR := FINDPTR^.SAME;
                      Z := Z - 1;
                    end;
                    Z := D;
                    if FINDPTR = NIL then FLAG := FALSE
                    else
                      begin
                        OUTSTRNG4 := FINDPTR^.WORD;
                        FINDPTR   := FINDPTR^.SUB;
                      end;
                        while ((V <> 1) and (FINDPTR <> NIL)) do
                          begin
                            FINDPTR := FINDPTR^.SAME;
                            V := V - 1;
                          end;
                          V := E;
                          if FINDPTR = NIL then FLAG := FALSE
                          else
                             begin
                               OUTSTRNG5 := FINDPTR^.WORD;
                               FINDPTR   := FINDPTR^.SUB;
                             end
                end
          end
    end;
  if FLAG then FINDBRANCH := TRUE
      else FINDBRANCH := FALSE
end;





procedure PRINTTREE(var INSTRING : STRING_80; var STEM : STACKTYPE);

var
  FLAGEND   : BOOLEAN;
  Q,R,S,T,U : INTEGER;
  PRNTSTR1, PRNTSTR2, PRNTSTR3, PRNTSTR4, PRNTSTR5: STRING_80;



begin
  FLAGEND := FALSE;
{  WRITELN('BEGIN PRINTING ALL COMBINATIONS:');}
  Q :=1; R:=1; S:=1; T:=1; U:=1;
  while not FLAGEND do begin
    if FINDBRANCH(Q,R,S,T,U,PRNTSTR1,PRNTSTR2,PRNTSTR3,
    PRNTSTR4,PRNTSTR5,INSTRING,STEM) then begin
    if ((QUESTNUM =PRNTSTR5) AND((INSTRING = PRNTSTR1)OR(INSTRING = PRNTSTR2)
    OR(INSTRING=PRNTSTR3)OR(INSTRING = PRNTSTR4))) then CreateOrder(Instring);

    {  WRITEln('First Element =',First_Element);
      WRITEln('Second Element =',Second_Element);
      WRITEln('Third Element =',Third_Element);
      WRITELN('Fourth Element =',Fourth_element);}
      T := T + 1
    end
    else begin
      if(PRNTSTR1='EMPTY') then FLAGEND := TRUE
      else begin
        if(PRNTSTR2='EMPTY') then begin
          Q := Q+1;
          R := 1;
        end
          else begin
            if(PRNTSTR3='EMPTY') then begin
              R := R+1;
              S := 1
            end
              else begin
                if(PRNTSTR4='EMPTY') then begin
                  S := S+1;
                  T := 1
                end
                  else begin
                    if (PRNTSTR5='EMPTY') then begin
                      T := T+1;
                      U := 1
                    end
                  end
              end
          end
      end
    end
  end
end;

procedure PRINTTREE1(var INSTRING : STRING_80; var STEM : STACKTYPE);

var
  FLAGEND   : BOOLEAN;
  Q,R,S,T,U : INTEGER;
  PRNTSTR1, PRNTSTR2, PRNTSTR3, PRNTSTR4, PRNTSTR5: STRING_80;



begin
  FLAGEND := FALSE;
{  WRITELN('BEGIN PRINTING ALL COMBINATIONS:');}
  Q :=1; R:=1; S:=1; T:=1; U:=1;
  while not FLAGEND do begin
    if FINDBRANCH(Q,R,S,T,U,PRNTSTR1,PRNTSTR2,PRNTSTR3,
    PRNTSTR4,PRNTSTR5,INSTRING,STEM) then begin
    if PRNTSTR5 = QUESTNUM then QUESTCNT := QUESTCNT +1;

    {  WRITEln('First Element =',First_Element);
      WRITEln('Second Element =',Second_Element);
      WRITEln('Third Element =',Third_Element);
      WRITELN('Fourth Element =',Fourth_element);}
      T := T + 1
    end
    else begin
      if(PRNTSTR1='EMPTY') then FLAGEND := TRUE
      else begin
        if(PRNTSTR2='EMPTY') then begin
          Q := Q+1;
          R := 1;
        end
          else begin
            if(PRNTSTR3='EMPTY') then begin
              R := R+1;
              S := 1
            end
              else begin
                if(PRNTSTR4='EMPTY') then begin
                  S := S+1;
                  T := 1
                end
                  else begin
                    if (PRNTSTR5='EMPTY') then begin
                      T := T+1;
                      U := 1
                    end
                  end
              end
          end
      end
    end
  end
end;

Procedure Parse(var comm : string_80);

const
  Space     = ' ';
  Question  = '?';
  Period    = '.';
  Exclamation = '!';


var
  Indx,Len  :  Integer;
  Rep, Instring       : string_80;
  Substitute, Substitute1 : string_80;

begin
   Len:=0;
   Rep := '';
   Instring := '';
   while Pos(Space,comm)=1 do
   Delete(comm,1,1);
   Len := Pos(Space,Comm);
   substitute1 := comm;
   delete(substitute1,1,Len);

   Repeat
     substitute := comm;
     Len:=Pos(Space,comm);
     Rep := Instring;
     Instring := Copy(comm,1,Len-1);
     If rep <> '' then
     Instring := rep  + ' ' + instring;
     {writeln('Instring=',Instring,'!');}
     Printtree(Instring, root);
     {if Isbranch(num1,Instring,num2,Instring,num3,Instring,num4,Instring,num5,Questnum,root)

                then write('FOLLOWING BRANCH IS ON TREE:',Instring);}
     Delete(substitute,1,Len);
     comm := substitute;
   {  writeln('Instring =',Instring,'!');}
   until pos(Space,comm) = 0;
   If Instring <> '' then
   Instring := Instring + ' ' + comm;
  { writeln('Instring =',Instring,'!');}
   Printtree(Instring,root);
   {if Isbranch(num1,Instring,Num2,Instring,Num3,Instring,Num4,Instring,Num5,Questnum,root)
                then write('FOLLOWING BRANCH IS ON TREE:',Instring);}
   If pos(Space, substitute1) = 0 then
      begin
        Instring := comm;
       { writeln('last Instring =',Instring);}
        Printtree(Instring,root);
        {if Isbranch(num1,Instring,Num2,Instring,num3,Instring,num4,Instring,Num5,Questnum,root)
                then write('FOLLOWING BRANCH IS ON TREE:', Instring)}
      end;
   While pos(Space,substitute1) <>0 do
   Parse(substitute1);
 end;



(* Procedure writeout(outtext: STRING_80) ;

 Begin
     GotoXY(((80-length(outtext) + 2) div 2),k);
     writeln(outtext)
 End; *)



 (***************************************************************************)



 (***************************************************************************)
Procedure inputline(var  instring  : string_80);
var
  key  :  byte;
  FuncKey  : boolean;
  inchar : char;

function getkey : Byte;

begin
  FuncKey := false;
  repeat until KeyPressed;
    if KeyPressed then
      begin
       letter := ReadKey;
{! 3. USE TUR^BO3 unit for access to KBD, or instead USE CRT and ReadKey.}
        if letter = #0 then
          begin
            letter := ReadKey;
{! 4. USE TURBO3 ^unit for access to KBD, or instead USE CRT and ReadKey.}
            FuncKey := true;
          end
      end;
      key:=ord(letter);
      Case key of
        01 : key := 132;
        15 : key := 148;
        21 : key := 129
      end;
      if FuncKey then
        begin
          Case key of
            01 : key := 132 ;
            30 : key := 142 ;
            15 : key := 148 ;
            24 : key := 153 ;
            21 : key := 129 ;
            22 : key := 154 ;
            31 : key := 225 ;
          end
        end;
        GetKey := key;

       end;

begin
  instring := '';
  Repeat
    inchar := chr(Getkey) ;
         If (key = 8) then
            begin
              Delete(instring,length(instring),1);
              gotoXY(Hor,WhereY);
              ClrEol;
              write(instring)
            end
         Else if (key <> 8) then instring := instring + inchar ;
    If (((key <> 13) or (length(instring) <> 80))and (key<>8)) then write(inchar)
  Until ((key = 13) or (length(instring)=80)) ;
  If (key = 13) then Delete(instring,length(instring),1);
    If length(instring)<> 0 then
      begin
        while Copy(instring,length(instring),1) = chr(32) do
        delete(instring,length(instring),1);
        while pos(space,instring)=1 do
        Delete(instring,1,1)
      end
End ;


Procedure CheckArray;

  Var
    InArray    :  Boolean;
    CheckString4  :  String_80;
    CheckString3  :  String_80;
    CheckString2  :  String_80;
    Len4          :  Integer;
    Len3          :  Integer;
    Len2          :  Integer;

begin
  CheckString4 := First_Element +' '+Second_element +' '+Third_Element +' '+Fourth_Element;
  Len4 := Length(CheckString4);
  delay(2000);
  CheckString3 := First_Element +' '+Second_element +' '+Third_Element;
  Len3 := Length(CheckString3);
  CheckString2 := First_Element + ' ' + Second_Element;
  Len2 := Length(CheckString2);
  InArray := false;
  For Index := 1 to Counter1-1 do
    begin
      if CorrectArray[Counter1] = CorrectArray[Index] then InArray := true
    end;
  If InArray = true then
    begin
      Counter1:= Counter1-1;
      WordCnt1 := WordCnt1+1;
      QUESTCNT := QUESTCNT + 1;
      doloop1:=true;
      writeln;
      writeln('YOU HAVE ALREADY CREATED THIS SENTENCE, TRY AGAIN!');
      writeln
    end
  else
    if((Fourth_Element = '') and (Third_Element = '')and (Len2 < Length(ANSWER1)))
          then
            begin
             GotoXY(1,7);
             writeln('           You used extra elements,spaces or letters, try again.');
             Counter1:= Counter1-1;
             WordCnt1 := WordCnt1+1;
             QUESTCNT := QUESTCNT + 1;
             doloop1:=true
           end
    else
    if ((Fourth_Element = '') and (len3 < Length(ANSWER1)))
       then
       begin
            GotoXY(1,7);
            writeln('           You used extra elements,spaces or letters, try again.');
            Counter1:= Counter1-1;
            WordCnt1 := WordCnt1+1;
            QUESTCNT := QUESTCNT + 1;
            doloop1:=true
       end
       else
       If Len4 < Length(ANSWER1)
       then
         begin
           GotoXY(1,7);
           writeln('           You used extra elements,spaces or letters, try again.');
           Counter1:= Counter1-1;
           WordCnt1 := WordCnt1+1;
           QUESTCNT := QUESTCNT + 1;
           doloop1:=true
        end
     else
     begin
      GotoXY(1,7);
      writeln('                                 CORRECT.');
      Delay(1000);
      GotoXy(1,7);
      ClrEol
    end
end;


 BEGIN
  Nums:=[1..10];
  EncompassingLoop:=true;
  while EncompassingLoop=true do
  begin
   Doloop := true;
   Doloop1 := true;
   Counter :=0;
   ClrScr;
   GotoXY(1,24);
   write('ä = CtrlA   ü = CtrlU   ö = CtrlO   Ä = AltA   Ü = AltU   Ö = AltO   ß = AltS');
   CreateWindow(1,1,80,11);
   GotoXY(1,1);
   writeln('You will translate the following sentences:');
   writeln('Input lesson number corresponding to Kapitel number: ');
   readln(lesson_number);
   Lesson_number := 'trans'+lesson_number;
   NUM1 :=1;NUM2 :=2;NUM3:=3;NUM4:=4;NUM5:=1;
   make(ROOT);
   recalltree(ROOT);
   Assign (TRANSLATFile, Lesson_number+'.dat');
   Reset(TRANSLATFile);
   WordCnt :=1;
   READLN (TRANSLATFile, Skeleton);
   VOCABULARY[WordCnt]:=skeleton;
     while (skeleton <> SENTINEL)  do
      begin
        WordCnt := WordCnt +1;
        READLN (TRANSLATFile, Skeleton);
        VOCABULARY[WordCnt]:=skeleton;
      end;
      Close(TRANSLATFile);
      WordCnt:=WordCnt-1;
      Counter :=0;
   ClrScr;
   FillChar(NonRepeatArray,SizeOf(NonRepeatArray),0);
   FillChar(CorrectArray,SizeOf(CorrectArray),0);
   Counter1:=0;
   While doloop do
     begin
         doloop1:=true;
         CreateWindow(1,1,80,11);
         GotoXY(1,1);
         ClrScr;
         Randomize;
         repeat
           Y := random(WordCnt)+1;
           Str(Y,QUESTNUM);
          until NonRepeatArray[Y] = 0;
          NonRepeatArray[Y] := 1;
          Word := VOCABULARY[Y];
          Writeln(Word);
          QUESTCNT :=0;
       While doloop1 do
         begin
           PRINTTREE1(WORD,ROOT);
           If QUESTCNT >1 then
             begin
               repeat
                 write('There are ',QUESTCNT,
                 ' answers to this question. How many do you want:');
                 Readln(Answer);
                 val(Answer,Temp,Result);
                 until ((Result = 0) and (Temp in Nums) and (Temp <= QUESTCNT));
               If temp =1 then QUESTCNT :=1 else QUESTCNT := Temp;
               ClrScr;
               GotoXY(1,1);
               writeln(word)

             end;
         Repeat
           GotoXY(1,2);
            COUNT := 0;
            num1 := 1; num2 := 2; num3 := 3; num4 := 4; num5 := 5;
            First_Element := '';Second_Element := '';Third_Element := ''; Fourth_Element := '';
           { Fifth_Element := QUESTNUM; }
            Writeln('Input sentence: ');
            GotoXY(1,3);
            HOR := WhereX;
            Inputline(Input);
            Answer1 := Input;
            GotoXY(1,4);
            Writeln('You have the following possibly correct elements in your translation:');
            GotoXY(1,5);
            Parse(Input);
           If isbranch(num1,first_element,num2,second_element,
           num3,third_element,num4,fourth_element,
           Num5,QUESTNUM ,root) then
                begin
                     Counter1:=Counter1+1;
                     CorrectArray[Counter1] := first_element +' '+second_element+' '+third_element+' '+fourth_element;
                     doloop1 := false;
                     CheckArray;
                     GotoXY(1,8);
                     WRITELN('  TO CONTINUE PRESS ANY KEY EXCEPT "Q". "Q" FOR LIST OF SENTENCES CREATED.');
                     Ch := ReadKey;
                     If ((ch = 'q')or(ch = 'Q')) then begin
                       doloop := false;
                       doloop1:= false;
                       Questcnt := 0
                     end;
                     Writeln;
                     QUESTCNT := QUESTCNT -1;
                   end;
                   ClrScr;
                   GotoXY(1,1);
                   writeln(word);
                 until QUESTCNT <= 0;

         end {of inner Doloop};
          Counter := Counter +1;
          If counter  = WordCnt then doloop := false;
          Delay(500);

         ClrScr;
     end; {of outer doloop}
     CreateWindow(1,1,80,24);
     ClrScr;
     Writeln('You created ',Counter1,' sentences.');
     Writeln('Press any key to see list of sentences.');
     Writeln('Press Ctrl-S to stop and start scrolling.');
     Ch := ReadKey;
     ClrScr;
     For INDEX := 1 to Counter1 do
       writeln(CorrectArray[INDEX]);
       Writeln('Press any key to continue.');
         Ch := ReadKey;
         ClrScr;
         GotoXY(16,12);
         writeln('TO REPEAT LESSON OR DO ANOTHER LESSON PRESS "P"');
         Ch := ReadKey;
         If ((Ch='p')or(Ch='P'))then
           begin
             EncompassingLoop := true;
             Window(1,1,80,25);
             ClrScr
           end
         else
           begin
             EncompassingLoop :=false;
             ClrScr;
             GotoXY(32,12);
             Writeln('Auf Wiedersehen!')
           end;
 end{of encompassingLoop}
end.
end.